home *** CD-ROM | disk | FTP | other *** search
/ Power Tools 1993 October - Disc 2 / Power Tools (Disc 2)(October 1993)(HP).iso / superset / bin / calendar.mdl < prev    next >
Text File  |  1993-09-10  |  7KB  |  313 lines
  1. %!
  2. % PostScript program to draw calendar
  3. % Copyright (C) 1987 by Pipeline Associates, Inc.
  4. % Permission is granted to modify and distribute this free of charge.
  5.  
  6. % This program won't produce valid calendars before 1800 due to the switch
  7. % from Julian to Gregorian calendars in September of 1752 wherever English
  8. % was spoken.
  9.  
  10. /titlefont /NewCenturySchlbk-Bold def
  11. /textfont /Helvetica-Narrow-BoldOblique def
  12. /daynumfont /Helvetica-Narrow def
  13.  
  14. % calendar names - change these if you don't speak english
  15. % "August", "April" and "February" could stand to be kerned even if you do
  16.  
  17. /month_names
  18. [ (January ) (February ) (March ) (April ) (May ) (June ) (July )
  19. (August ) (September ) (October ) (November ) (December ) ]
  20. def
  21.  
  22. /day_names
  23. [ (Sunday) (Monday) (Tuesday) (Wednesday) (Thursday) (Friday) (Saturday) ]
  24. def
  25.  
  26. % layout parameters - you can change these, but things may not look nice
  27.  
  28. /daywidth 100 def
  29. /dayheight 95 def
  30.  
  31. /monthfontsize 32 def
  32. /titlefontsize 18 def
  33. /textfontsize 21 def
  34. /weekdayfontsize 14 def
  35. /datefontsize 20 def
  36.  
  37. /topgridmarg 22 def
  38. /leftmarg 30 def
  39. /daytopmarg 0 def
  40. /dayleftmarg 5 def
  41. /daynamemargin 25 def
  42. /monthmargin 40 def
  43.  
  44. % layout constants - don't change these, things probably won't work
  45.  
  46. /rows 5 def
  47. /subrows 6 def
  48.  
  49. % calendar constants - change these if you want a French revolutionary calendar
  50.  
  51. /days_week 7 def
  52.  
  53. /days_month [ 31 28 31 30 31 30 31 31 30 31 30 31 ] def
  54.  
  55. /isleap {                % is this a leap year?
  56.     year 4 mod 0 eq            % multiple of 4
  57.     year 100 mod 0 ne         % not century
  58.     year 1000 mod 0 eq or and    % unless it's a millenia
  59. } def
  60.  
  61. /ndays {                % number of days in this month
  62.     days_month month 1 sub get
  63.     month 2 eq            % February
  64.     isleap and
  65.     {
  66.         1 add
  67.     } if
  68. } def
  69.  
  70. /weekday {                % weekday (range 0-6) for integer date
  71.     days_week mod
  72. } def
  73.  
  74. /startday {                % starting day-of-week for this month
  75.     /off year 2000 sub def        % offset from start of "epoch"
  76.     off
  77.     off 4 idiv add            % number of leap years
  78.     off 100 idiv sub        % number of centuries
  79.     off 1000 idiv add        % number of millenia
  80.     6 add weekday days_week add     % offset from Jan 1 2000
  81.     /off exch def
  82.     1 1 month 1 sub {
  83.         /idx exch def
  84.         days_month idx 1 sub get
  85.         idx 2 eq
  86.         isleap and
  87.         {
  88.             1 add
  89.         } if
  90.         /off exch off add def
  91.     } for
  92.     off weekday            % 0--Sunday, 1--monday, etc.
  93. } def
  94.  
  95. % ------------------------------------------------------------------------
  96.  
  97. /prtnum { 
  98.     /width exch def
  99.     3 string cvs width right
  100. } def
  101.  
  102. /right {                % right justify string in given width
  103.     /width exch def
  104.     /str exch def 
  105.     width str stringwidth pop sub 0 rmoveto str show
  106. } def
  107.  
  108. /center {                % center string in given width
  109.     /width exch def
  110.     /str exch def width str 
  111.     stringwidth pop sub 2 div 0 rmoveto str show
  112. } def
  113.  
  114. /centernum { exch 3 string cvs exch center } def
  115.  
  116. /drawgrid {                % draw calendar boxes
  117.     titlefont findfont weekdayfontsize scalefont setfont
  118.     currentpoint /y0 exch def /x0 exch def
  119.     0 1 days_week 1 sub {
  120.         x0 y0 moveto
  121.         dup dup daywidth mul daynamemargin rmoveto
  122.         day_names exch get
  123.         daywidth center
  124.         x0 y0 moveto
  125.         daywidth mul topgridmarg rmoveto
  126.         1.0 setlinewidth
  127.         /rowsused rows 1 sub def
  128.         0 1 rowsused {
  129.             gsave
  130.             daywidth 0 rlineto 
  131.             0 dayheight neg rlineto
  132.             daywidth neg 0 rlineto
  133.             closepath stroke
  134.             grestore
  135.             0 dayheight neg rmoveto
  136.         } for
  137.     } for
  138. } def
  139.  
  140. /drawnums {                % place day numbers on calendar
  141.     daynumfont findfont datefontsize scalefont setfont
  142.     /start startday def
  143.     /days ndays def
  144.     start daywidth mul dayleftmarg add daytopmarg rmoveto
  145.  
  146.     1 1 days {
  147.         /day exch def
  148.         gsave
  149.         % Saturday?
  150.         day start add weekday 0 eq
  151.         {
  152.             .5 setgray
  153.         } if
  154.         % Sunday?
  155.         day start add weekday 1 eq
  156.         {
  157.             .5 setgray
  158.         } if
  159.         60 -65 rmoveto
  160.         isdouble
  161.         {
  162.             day prtdouble
  163.         }
  164.         {
  165.             day 30 prtnum
  166.         } ifelse
  167.         grestore
  168.         day start add weekday 0 eq
  169.         {
  170.             currentpoint exch pop dayheight sub 0 exch moveto
  171.             dayleftmarg 0 rmoveto
  172.         }
  173.         {
  174.             daywidth 0 rmoveto
  175.         } ifelse
  176.     } for
  177. } def
  178.  
  179. /isdouble {                % overlay today with next/last week?
  180.     days start add rows days_week mul gt
  181.     {
  182.         day start add rows days_week mul gt
  183.         {
  184.             true true
  185.         }
  186.         {
  187.             day start add rows 1 sub days_week mul gt
  188.             day days_week add days le and
  189.             {
  190.                 false true
  191.             }
  192.             {
  193.                 false
  194.             } ifelse
  195.         } ifelse
  196.     }
  197.     {
  198.         false
  199.     } ifelse
  200. } def
  201.  
  202. /prtdouble {
  203.     gsave
  204.       daynumfont findfont datefontsize 2 mul 3 div scalefont setfont
  205.       exch
  206.       {
  207.         (23/) stringwidth pop dayheight rmoveto
  208.         2 prtnum
  209.       }
  210.       {
  211.         0 datefontsize 5 div rmoveto
  212.         2 prtnum
  213.         0 datefontsize -5 div rmoveto
  214.         gsave
  215.           daynumfont findfont datefontsize scalefont setfont
  216.           (/) show
  217.         grestore
  218.       } ifelse
  219.     grestore
  220. } def
  221.  
  222. /drawfill {                % place fill squares on calendar
  223.     /start startday def
  224.     /days ndays def
  225.     currentpoint /y0 exch def /x0 exch def
  226.     /fillstart 0 def
  227.     fillstart daywidth mul topgridmarg rmoveto
  228.     1.0 setlinewidth
  229.     fillstart 1 start 1 sub {
  230.         gsave
  231.         .99 setgray
  232.         daywidth 0 rlineto 
  233.         0 dayheight neg rlineto
  234.         daywidth neg 0 rlineto
  235.         closepath fill
  236.         grestore
  237.         daywidth 0 rmoveto
  238.     } for
  239.     x0 y0 moveto
  240.         /lastday rows days_week mul def
  241.         days_week 1 sub daywidth mul
  242.             rows dayheight mul topgridmarg sub neg rmoveto
  243.     lastday -1 ndays start 1 add add
  244.     {
  245.         /day exch def
  246.         gsave
  247.         .99 setgray
  248.         daywidth 0 rlineto 
  249.         0 dayheight rlineto
  250.         daywidth neg 0 rlineto
  251.         closepath fill
  252.         grestore
  253.         day weekday 1 eq
  254.         {
  255.             x0 y0 moveto
  256.             days_week 1 sub daywidth mul
  257.                 rows dayheight mul topgridmarg sub neg rmoveto
  258.         }
  259.         {
  260.             daywidth neg 0 rmoveto
  261.         } ifelse
  262.     } for
  263. } def
  264.  
  265. /daytext {
  266.  
  267. /text exch def
  268. /lineno exch 1 sub def
  269. /day exch startday add 1 sub def
  270.  
  271. /week day 7 idiv def
  272. /dow day week 7 mul sub def
  273.  
  274. x0 y0 moveto
  275. textfont findfont textfontsize scalefont setfont
  276. /lineheight 30 def
  277. dow daywidth mul dayleftmarg add
  278.       week dayheight mul lineno lineheight mul add neg rmoveto
  279. text show
  280.  
  281. } def
  282.  
  283. /calendar
  284. {
  285. titlefont findfont monthfontsize scalefont setfont
  286. /month_name month_names month 1 sub get def
  287. /yearstring year 10 string cvs def
  288. 306 leftmarg add dayleftmarg 2 mul add
  289.            month_name stringwidth pop 
  290.            yearstring stringwidth pop add 2 div sub monthmargin moveto
  291. month_name show
  292. yearstring show
  293.  
  294. 0 -5 moveto
  295. drawnums
  296.  
  297. 0 -5 moveto
  298. drawfill
  299.  
  300. 0 -5 moveto
  301. drawgrid
  302. } def
  303.  
  304. /pagetitle {
  305. gsave
  306. titlefont findfont titlefontsize scalefont setfont
  307. 306 756 translate
  308. name stringwidth pop 2 div neg 0 moveto
  309. name show
  310. grestore
  311. } def
  312.  
  313.